home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / nfsrc21.zip / METAPH.PRG < prev    next >
Text File  |  1991-08-15  |  15KB  |  394 lines
  1. /*
  2.  * File......: METAPH.PRG
  3.  * Author....: Dave Adams
  4.  * Date......: $Date:   15 Aug 1991 23:04:00  $
  5.  * Revision..: $Revision:   1.2  $
  6.  * Log file..: $Logfile:   E:/nanfor/src/metaph.prv  $
  7.  * 
  8.  * This is an original work by Dave Adams and is placed in the
  9.  * public domain.
  10.  *
  11.  * Modification history:
  12.  * ---------------------
  13.  *
  14.  * $Log:   E:/nanfor/src/metaph.prv  $
  15.  * 
  16.  *    Rev 1.2   15 Aug 1991 23:04:00   GLENN
  17.  * Forest Belt proofread/edited/cleaned up doc
  18.  * 
  19.  *    Rev 1.1   14 Jun 1991 19:52:20   GLENN
  20.  * Minor edit to file header
  21.  * 
  22.  *    Rev 1.0   01 Apr 1991 01:01:44   GLENN
  23.  * Nanforum Toolkit
  24.  *
  25.  */
  26.  
  27.  
  28. /*  $DOC$
  29.  *  $FUNCNAME$
  30.  *     FT_METAPH()
  31.  *  $CATEGORY$
  32.  *     String
  33.  *  $ONELINER$
  34.  *     Convert a character string to MetaPhone format
  35.  *  $SYNTAX$
  36.  *     FT_METAPH( <cName> [, <nSize> ] ) -> cMetaPhone
  37.  *  $ARGUMENTS$
  38.  *     <cName> is the character string to convert
  39.  
  40.  *     <nSize> is the length of the character string to be returned.
  41.  *             If not specified the default length is 4 bytes.
  42.  *  $RETURNS$
  43.  *     A phonetically spelled character string
  44.  *  $DESCRIPTION$
  45.  *     This function is a character function use to index and search for
  46.  *     sound-alike or phonetic matches.  It is an alternative to 
  47.  *     the SOUNDEX() function, and addresses some basic pronunciation
  48.  *     rules, by looking at surrounding letters to determine how parts of
  49.  *     the string are pronounced.  FT_METAPH() will group sound-alikes
  50.  *     together, and forgive shortcomings in spelling ability.
  51.  *  $EXAMPLES$
  52.  *     USE Persons
  53.  *     INDEX ON FT_METAPH( LastName ) TO LastName
  54.  *     SEEK FT_METAPH( "Philmore" )
  55.  *     ? FOUND(), LastName             // Result: .T. Philmore
  56.  *     SEEK FT_METAPH( "Fillmore" )
  57.  *     ? FOUND(), LastName             // Result: .T. Philmore
  58.  *  $END$
  59.  */
  60.  
  61. /*
  62.  * File Contents
  63.  * 
  64.  *   FT_METAPH()      Calculates the metaphone of a name
  65.  *   _ftMakeAlpha()   Removes non-alpha characters from a string
  66.  *   _ftConvVowel()   Converts all vowels to the letter 'v'
  67.  *
  68.  *
  69.  * Commentary
  70.  *
  71.  *  The concepts for this algoritm were adapted from an article in the
  72.  *  Computer Language Magazine (Dec.90, Vol.7, No.12) written by
  73.  *  Lawrence B.F. Phillips.
  74.  *
  75.  *  The STRTRAN function was selected to calculate the MetaPhone, to
  76.  *  allow the algoritm to be fine-tuned in an easy manner, as there are
  77.  *  always exceptions to any phonetic pronunciation in not only English,
  78.  *  but many other languages as well.
  79.  *
  80.  *  What is a metaphone?
  81.  *  Basically it takes a character string, removes the vowels, and equates
  82.  *  letters (or groups of letters) to other consonent sounds.  The vowels
  83.  *  are not removed until near the end, as they play an important part
  84.  *  in determining how some consonents sound in different surroundings.
  85.  *
  86.  *  The consonant sounds are:  B, F, H, J, K, L, M, N, P, R, S, T, W, X, Y, 0
  87.  *  Vowels are only included if they are at the beginning.
  88.  *  Here are the transformations. The order of evaluation is important
  89.  *  as characters may meet more than one transformation conditions.
  90.  *  ( note: v = vowel )
  91.  *
  92.  *    B --> B  unless at end of a word after 'm' as in dumb.
  93.  *    C --> X  (sh)  CIA, TCH, CH, ISCH, CC
  94.  *           S  SCI, SCE, SCY, CI, CE, CY
  95.  *           K  otherwise ( including CK )
  96.  *    D --> J  DGE, DGY, DGI
  97.  *           T  otherwise
  98.  *    F --> F
  99.  *    G --> K  GHv, vGHT
  100.  *           W  vGH
  101.  *           J  DGE, DGY, DGI, GI, GE, GY
  102.  *           N  GN
  103.  *           K  otherwise
  104.  *    H --> H  vHv
  105.  *              otherwise silent
  106.  *    J --> J
  107.  *    K --> K
  108.  *    L --> L
  109.  *    M --> M
  110.  *    N --> N
  111.  *    P --> F  PH
  112.  *           P  otherwise
  113.  *    Q --> K
  114.  *    R --> R
  115.  *    S --> X  (sh) SH, SIO, SIA, ISCH
  116.  *           S  otherwise
  117.  *    T --> X  (sh) TIA, TIO, TCH
  118.  *           0  (th) TH
  119.  *           T  otherwise
  120.  *    V --> F
  121.  *    W --> W
  122.  *    X --> KS
  123.  *    Y -->    vY
  124.  *           Y  otherwise
  125.  *    Z --> S
  126.  *
  127.  */
  128.  
  129. *------------------------------------------------
  130. //  Demo of FT_METAPH()
  131.  
  132. //  #define FT_TEST .T.
  133.  
  134. #IFDEF FT_TEST
  135.   FUNCTION MAIN()
  136.   LOCAL cJunk  := SPACE( 8000 )
  137.   LOCAL aNames := {}
  138.   LOCAL cName, nElem
  139.  
  140.   SET( _SET_SCOREBOARD, .F.   )
  141.   SET( _SET_COLOR,      "W/B" )
  142.   CLS
  143.  
  144.   //  Demo will create an array of names and display in 3 columns
  145.   //  _ftRow() and _ftCol() will calculate the screen co-ordinates
  146.   //  by evaluating the element number
  147.  
  148.   AADD( aNames, "Adams"        )
  149.   AADD( aNames, "Addams"       )
  150.   AADD( aNames, "Atoms"        )
  151.   AADD( aNames, "Adamson"      )
  152.   AADD( aNames, "Cajun"        )
  153.   AADD( aNames, "Cagen"        )
  154.   AADD( aNames, "Cochy"        )
  155.   AADD( aNames, "Cocci"        )
  156.   AADD( aNames, "Smith"        )
  157.   AADD( aNames, "Smythe"       )
  158.   AADD( aNames, "Naylor"       )
  159.   AADD( aNames, "Nailer"       )
  160.   AADD( aNames, "Holberry"     )
  161.   AADD( aNames, "Wholebary"    )
  162.   AADD( aNames, "Jackson"      )
  163.   AADD( aNames, "Jekksen"      )
  164.   AADD( aNames, "The Source"   )
  165.   AADD( aNames, "The Sores"    )
  166.   AADD( aNames, "Jones"        )
  167.   AADD( aNames, "Johns"        )
  168.   AADD( aNames, "Lennon"       )
  169.   AADD( aNames, "Lenin"        )
  170.   AADD( aNames, "Fischer"      )
  171.   AADD( aNames, "Fisher"       )
  172.   AADD( aNames, "O'Donnell"    )
  173.   AADD( aNames, "O Donald"     )
  174.   AADD( aNames, "Pugh"         )
  175.   AADD( aNames, "Pew"          )
  176.   AADD( aNames, "Heimendinger" )
  177.   AADD( aNames, "Hymendinker"  )
  178.   AADD( aNames, "Knight"       )
  179.   AADD( aNames, "Nite"         )
  180.   AADD( aNames, "Lamb"         )
  181.   AADD( aNames, "Lamb Chops"   )
  182.   AADD( aNames, "Stephens"     )
  183.   AADD( aNames, "Stevens"      )
  184.   AADD( aNames, "Neilson"      )
  185.   AADD( aNames, "Nelson"       )
  186.   AADD( aNames, "Tchaikovski"  )
  187.   AADD( aNames, "Chikofski"    )
  188.   AADD( aNames, "Caton"        )
  189.   AADD( aNames, "Wright"       )
  190.   AADD( aNames, "Write"        )
  191.   AADD( aNames, "Right"        )
  192.   AADD( aNames, "Manual"       )
  193.   AADD( aNames, "Now"          )
  194.   AADD( aNames, "Wheatabix"    )
  195.   AADD( aNames, "Science"      )
  196.   AADD( aNames, "Cinzano"      )
  197.   AADD( aNames, "Lucy"         )
  198.   AADD( aNames, "Reece"        )
  199.   AADD( aNames, "Righetti"     )
  200.   AADD( aNames, "Oppermann"    )
  201.   AADD( aNames, "Bookkeeper"   )
  202.   AADD( aNames, "McGill"       )
  203.   AADD( aNames, "Magic"        )
  204.   AADD( aNames, "McLean"       )
  205.   AADD( aNames, "McLane"       )
  206.   AADD( aNames, "Maclean"      )
  207.   AADD( aNames, "Exxon"        )
  208.  
  209.   // display names and metaphones in 3 columns on screen
  210.   AEVAL( aNames, ;
  211.          { | cName, nElem | ;
  212.              SETPOS( _ftRow( nElem ), _ftCol( nElem ) ), ;
  213.              QQOUT( PadR( cName, 18, "." ) + FT_METAPH( cName ) ) ;
  214.          } )
  215.  
  216.   SETPOS( 21, 00 )
  217.   QUIT
  218.  
  219.   *------------------------------------------------
  220.   STATIC FUNCTION _ftRow( nElem )  //  Determine which row to print on
  221.   RETURN IIF( nElem > 40, nElem - 40, IIF( nElem > 20, nElem - 20, nElem ) )
  222.   *------------------------------------------------
  223.   STATIC FUNCTION _ftCol( nElem )  //  Determine which column to start print
  224.   RETURN IIF( nElem > 40,  55, IIF( nElem > 20, 28, 1 ) )
  225.   *------------------------------------------------
  226.  
  227. #endif
  228. // End of Test program
  229.  
  230. *------------------------------------------------
  231. FUNCTION FT_METAPH ( cName, nSize )
  232. //  Calculates the metaphone of a character string
  233.  
  234. LOCAL cMeta
  235.  
  236. cName := IIF( cName == NIL, "", cName )  //  catch-all
  237. nSize := IIF( nSize == NIL, 4,  nSize )  //  default size: 4-bytes
  238.  
  239. //  Remove non-alpha characters and make upper case.
  240. //  The string is padded with 1 space at the beginning & end.
  241. //  Spaces, if present inside the string, are not removed until all
  242. //  the prefix/suffix checking has been completed.
  243. cMeta := " " + _ftMakeAlpha( UPPER( ALLTRIM( cName ) ) ) + " "
  244.  
  245. //  prefixes which need special consideration
  246. IF " KN"   $ cMeta ;  cMeta := STRTRAN( cMeta, " KN" , " N"  ) ;  ENDIF
  247. IF " GN"   $ cMeta ;  cMeta := STRTRAN( cMeta, " GN" , " N"  ) ;  ENDIF
  248. IF " PN"   $ cMeta ;  cMeta := STRTRAN( cMeta, " PN" , " N"